home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / CGIshell 1.3.2 / samples / Length / length.4th next >
Encoding:
Text File  |  1996-04-23  |  2.3 KB  |  97 lines  |  [TEXT/ALFA]
  1. \
  2. \ Physics Units Conversions  -  Length  - Using CGI shell 1.3
  3. \
  4. \ Ronald T. Kneusel, rkneusel@post.its.mcw.edu, 27-Oct-95
  5. \
  6. \ Last mod: 21-Mar-96
  7. \
  8. \
  9. \ All conversions are a table lookup.  The calculation is:
  10. \
  11. \   dest value =  (array[dest]/array[source]) * source value
  12. \
  13. \ where array[dest] returns the address of a floating point
  14. \ constant for that conversion
  15. \
  16.  
  17. ( load CGI shell )
  18.  
  19. --> shell.4th
  20.  
  21. ( strings and such )
  22.  
  23. $[ fname length.txt]    \ template filename
  24.  
  25. INT 5 " source" #field src     \ fields
  26. INT 5 " dest"   #field dest
  27. FP 20 " value"  #field val
  28.  
  29. FP 30 " answer" #object ans      \ answer
  30. STR 30 " 1st"   #object one      \ 1st unit name
  31. STR 30 " 2nd"   #object two      \ 2nd unit name
  32.  
  33. message[ u0 m]     \ unit names
  34. message[ u1 angstrom]
  35. message[ u2 AU]
  36. message[ u3 cm]
  37. message[ u4 fm]
  38. message[ u5 ft]
  39. message[ u6 in]
  40. message[ u7 km]
  41. message[ u8 ly]
  42. message[ u9 micron]
  43. message[ u10 nmi]
  44. message[ u11 parsec]
  45. message[ u12 mi]
  46. message[ u13 yd]
  47.  
  48. 14 array>> U            \ unit names array
  49. u0 u1 u2 u3 u4 u5 u6 u7 u8 u9 u10 u11 u12 u13 14 U >array
  50.  
  51. 2048 String>> out      \ output string
  52.  
  53. ( use template's array words for the conversion array )
  54.  
  55. 15 array>> ang
  56.  
  57. ( length constants )
  58.  
  59. : >ang ( v indx -- )  ang !array ;
  60.  
  61. fvariable &0  fvariable &1  fvariable &2  fvariable &3 
  62. fvariable &4  fvariable &5  fvariable &6 
  63. fvariable &7  fvariable &8  fvariable &9  fvariable &10 
  64. fvariable &11  fvariable &12  fvariable &13 
  65.  
  66. &0 0 >ang &1 1 >ang &2 2 >ang &3 3 >ang &4 4 >ang &5 5 >ang 
  67. &6 6 >ang &7 7 >ang &8 8 >ang &9 9 >ang &10 10 >ang 
  68. &11 11 >ang &12 12 >ang &13 13 >ang 
  69.  
  70. ( setup array values - conversion constants )
  71.  
  72. 1.0 &0 f!  1.0e10 &1 f!   6.685e-12 &2 f!   100.0 &3 f!
  73. 1.0e15 &4 f!  3.281 &5 f!  39.37 &6 f!  1.0e-3 &7 f!
  74. 1.057e-16 &8 f!  1.0e6 &9 f!  5.400e-4 &10 f!  6.214e-4 &12 f!
  75. 3.241e-17 &11 f!  1.094 &13 f!
  76.  
  77. ( do the conversion )
  78.  
  79. : calc ( -- )  \ calculate
  80.    dest @val ang @array f@  src @val ang @array f@  f/   
  81.    \  array[dest]/array[source]
  82.    val @val f*  ans !val
  83. ;
  84.  
  85. ( Apple Event handler )
  86.  
  87. ,s sdoc  ,s WWWΩ  ae:
  88.    <getFields>
  89.    src @val  U @array one !val             \ unit names
  90.    dest @val U @array two !val
  91.    calc                                    \ calculate answer
  92.    out fname NEW template                  \ build reply
  93.    out REPLY                               \ send reply
  94.    bye
  95. ;ae
  96.  
  97.